home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / menu / toadmenu.arc / MENU.INC next >
Encoding:
Text File  |  1987-10-30  |  10.5 KB  |  367 lines
  1. {menu.inc}
  2. (*
  3. Copyright (C)  David P Kirschbaum  All Rights Reserved
  4. *)
  5.  
  6. PROCEDURE Window_Frame(x1,y1, x2,y2 : INTEGER);
  7.   {Create, frame and title a window}
  8.   VAR
  9.     x,
  10.     center : INTEGER;
  11.  
  12.   BEGIN
  13.     Window(1,1,80,25);
  14.  
  15.     Box(PRED(x1), PRED(y1), SUCC(x2), SUCC(y2), WHITE, double);
  16.  
  17.     center := ((x2 - x1) SHR 1) + x1;
  18.     x := center - (LENGTH(MenuTitle) SHR 1);
  19.     IF ODD(center) AND FALSE
  20.     THEN x := PRED(x);
  21.     GotoXY(x, PRED(y1) );
  22.     IF Color THEN BEGIN
  23.       TextColor(WHITE);
  24.       TextBackGround(RED);
  25.     END
  26.     ELSE RvsOn;
  27.     WRITE(MenuTitle);
  28.     RvsOff;
  29.     Window(x1,y1,x2,y2);
  30.     ClrScr;
  31.   END;  {of Window_Frame}
  32.  
  33.  
  34. PROCEDURE Lower_Window(Openw : BOOLEAN);
  35.   BEGIN
  36.     IF Openw THEN BEGIN               {open it}
  37.       Window(t_x, SUCC(T_Y), t_x+maxtxtlen, 23); {open window at screen base}
  38.       ClrScr;
  39.       GotoXY(1,1);
  40.     END
  41.     ELSE                         {close one already open}
  42.       Window(m_x, M_Y, m_x + maxitemlen, PRED(T_Y));
  43.   END;  {of Lower_Window}
  44.  
  45.  
  46. PROCEDURE Show_Cmd(Cmd : Str80);
  47.   BEGIN
  48.     IF Cmd[1] = '*' THEN Delete(Cmd,1,1);  {gobble asterisks}
  49.     len := LENGTH(Cmd);
  50.     IF Cmd[len] = '%' THEN Delete(Cmd,len,1);  {gobble %}
  51.     GotoXY(1,2);                      {reposition to overwrite}
  52.     Write( Centered(maxtxtlen,Cmd) );  {write new cmd string}
  53.   END;  {of Show_Cmd}
  54.  
  55.  
  56. PROCEDURE Get_Cmd;
  57.   VAR TCmd : Str40;
  58.   BEGIN  {Get_Cmd}
  59.     len := LENGTH(Cmd[menuptr]);
  60.     IF Cmd[menuptr][len] <> '%'
  61.     THEN BEGIN                          {no user command parms permitted}
  62.       CmdParm := Cmd[menuptr];          {return cmd string if any}
  63.       Exit;
  64.     END;
  65.  
  66.     Lower_Window(TRUE);                 {open window at screen base}
  67.     Writeln( Centered(maxtxtlen, Txt[menuptr]) );
  68.  
  69.     CmdParm := Copy(Cmd[menuptr],1,PRED(len));
  70.     Show_Cmd(CmdParm);
  71.     GotoXY(1,3);                        {3d line for cmd parms}
  72.     Write('Enter Command Parameters: ');
  73.     Cursor(on);
  74.     Readln(TCmd);
  75.     Cursor(off);
  76.     GotoXY(1,1);
  77.     IF TCmd <> ''                       {got an entry}
  78.     THEN CmdParm := CmdParm             {build new DOS cmd string}
  79.                     + ' ' + TCmd;
  80.  
  81.     Show_Cmd(CmdParm);                  {display new cmd string}
  82.     Lower_Window(FALSE);                {close it again}
  83.   END;  {of Get_Cmd}
  84.  
  85.  
  86. PROCEDURE Do_CmdStuff(p : INTEGER);
  87.   BEGIN
  88.     Lower_Window(TRUE);                 {open window at screen base}
  89.     Write( Centered(maxtxtlen, Txt[p]) );
  90.     Show_Cmd(Cmd[p]);                   {display DOS command}
  91.  
  92.     Lower_Window(FALSE);                {close lower window}
  93.   END;  {of Do_CmdStuff}
  94.  
  95.  
  96. PROCEDURE Repaint(p : INTEGER; Highlighted : BOOLEAN);
  97.   {Display the (menuptr) item on the menu screen,
  98.    highlighted (current) or normal (last).
  99.   }
  100.   BEGIN
  101.     IF Highlighted THEN BEGIN           {highlight the current menu item}
  102.       IF Color THEN BEGIN
  103.         TextBackGround(BLUE);
  104.         TextColor(LIGHTGRAY);
  105.       END
  106.       ELSE RvsOn;
  107.     END
  108.     ELSE BEGIN                          {UNHIGHLIGHT THE OLD SELECTION}
  109.       IF Color THEN BEGIN
  110.         TextBackGround(BLACK);
  111.         TextColor(CYAN);
  112.       END
  113.       ELSE RvsOff;
  114.     END;
  115.  
  116.     IF NOT FirstMenu THEN y := p - 9
  117.     ELSE y := SUCC(p);
  118.  
  119.     IF LENGTH(FKey[y]) <= 2  THEN x := 4
  120.     ELSE x := 5;
  121.  
  122.     GotoXY( x, y );  WRITE('  ');       {blank out after FKey}
  123.     IF x = 4 THEN WRITE(' ');
  124.  
  125.     WRITE(Item[p]);                     {Write menu entry}
  126.     ClrEol;                             {blank rest of item line}
  127.  
  128.  
  129.     GotoXY( 6 + hlcharpos[p],y );
  130.     IF Highlighted THEN BEGIN
  131.       IF NOT Color THEN TextBackGround(BLACK);  {reverse key character}
  132.       TextColor(WHITE);
  133.     END
  134.     ELSE TextColor(LIGHTCYAN);
  135.     WRITE(HlChar[p]);
  136.  
  137.     IF HighLighted                    {just went active ...}
  138.     THEN Do_CmdStuff(p);              {so show DOS cmd & text}
  139.  
  140.   END;  {of Repaint}
  141.  
  142.  
  143. PROCEDURE New_Menu;
  144.   {Repaint current menu}
  145.   BEGIN
  146.     IF FirstMenu THEN BEGIN
  147.       minptr :=  1 ;
  148.       maxptr := 10
  149.     END
  150.     ELSE BEGIN
  151.       minptr := 11 ;
  152.       maxptr := menulen;
  153.     END;
  154.  
  155. {DISPLAY THE ACTUAL MENU SELECTIONS}
  156.     FOR menuptr := minptr TO maxptr DO BEGIN
  157.  
  158.       IF FirstMenu THEN y := SUCC(menuptr)
  159.       ELSE y := menuptr - 9;
  160.       GotoXY( 2, y );
  161.  
  162.       TextColor(BLACK);
  163.       TextBackGround(LIGHTGRAY);
  164.       IF FirstMenu THEN x := menuptr
  165.       ELSE x := menuptr - 10;
  166.       WRITE(FKey[x]);
  167.  
  168.       hlcharpos[menuptr] :=
  169.         POS(HlChar[menuptr],Item[menuptr]);
  170.  
  171.       Repaint(menuptr, FALSE);        {unhighlighted}
  172.     END;  {menuptr loop}
  173.  
  174. {IF MORE THAN 10 OPTIONS, PRINT NOTICE OF "MORE"}
  175.     IF LenOver10 THEN BEGIN
  176.       RvsOn;
  177.       GotoXY(2, T_Y - M_Y);  WRITE(Legend);
  178.       RvsOff;
  179.     END;
  180.  
  181.     IF FirstMenu THEN menuptr := default
  182.     ELSE menuptr := menulen;
  183.   END;  {of New_Menu}
  184.  
  185.  
  186. PROCEDURE Setup_Screen;
  187.   BEGIN
  188.     Cursor(off);
  189.  
  190.     Box(PRED(t_x), T_Y,           {frame bottom window}
  191.              SUCC(t_x + maxtxtlen), 24,
  192.              WHITE, double);
  193.  
  194.     GotoXY(1,25);
  195.     TextColor(LIGHTGRAY);
  196.     IF Color THEN TextBackGround(BLUE)
  197.     ELSE RvsOn;
  198.     WRITE(' ',#24,'-',#25,
  199.           '-move bar. Select by pressing a highlighted letter,',
  200.           ' a function key, or ',#17,#196,#217,' ');
  201.     IF Color THEN TextColor(WHITE);
  202.  
  203.     GotoXY(37,25);
  204.     WRITE('highlighted');
  205.     GotoXY(59,25);
  206.     WRITE('function key');
  207.     TextColor(BLACK);  TextBackGround(LIGHTGRAY);
  208.     GotoXY(2,25);  WRITE(#24);
  209.     GotoXY(4,25);  WRITE(#25);
  210.     GotoXY(76,25); WRITE(#17,#196,#217);
  211.     NormVideo;
  212.  
  213.     Window_Frame
  214.       ( m_x, M_Y, (m_x + maxitemlen), PRED(T_Y) );
  215.     New_Menu;                           {paint full menu}
  216.  
  217.   END;  {of Setup_Screen}
  218.  
  219.  
  220. PROCEDURE Init_Menu;
  221.   {Initialize stuff}
  222.   BEGIN
  223.     GetDir(0,CurrentDir);      {get current drive, directory,
  224.                                 save in global }
  225.  
  226. {pick up our current screen (color or mono), set global Color
  227.  boolean to TRUE (color) or FALSE (mono).
  228. }
  229.     x_scrn := PTR(screen_location,0);
  230.     y_scrn := PTR(screen_location,0);
  231.     oldcolor := PALLETTE;               {remember user's colors}
  232.     LenOver10 := (menulen > 10);        {we use this often to remember
  233.                                          if we have 2 menus}
  234.  
  235.     InChar := ' ';                      {INITIALIZE VARIABLES}
  236.     FirstMenu := TRUE;
  237.  
  238.     Legend := '';
  239.     IF LenOver10 THEN
  240.       Legend := Centered(PRED(maxitemlen),'more' + #196 + #16 + 'spacebar');
  241.  
  242. { CALCULATE AND FRAME WINDOW }
  243.  
  244.     m_x := (80 - maxitemlen) SHR 1;     {first the item menu window}
  245.     IF (ODD(maxitemlen)) AND FALSE
  246.     THEN m_x := SUCC(m_x);
  247.  
  248.     t_x := (80 - maxtxtlen) SHR 1;      {now text window}
  249.     IF Odd(t_x) THEN t_x := PRED(t_x);
  250.   END;  {of Init_Menu}
  251.  
  252.  
  253.  
  254. FUNCTION Check_Key (Func : BOOLEAN): BOOLEAN;
  255.   {He hit a function or other key, see if in our legal range.
  256.    IF Func is TRUE, we check for function keys, otherwise
  257.    see if the char is in our item chars.
  258.   }
  259.   BEGIN
  260.     Check_Key := TRUE;                  {assume true}
  261.     IF Func THEN len := POS(Inchar,SecKey)    {check for func keys}
  262.     ELSE len := POS(Upcase(InChar),           {check for chars}
  263.                     Copy(HlChar,minptr,255) );
  264.     IF (len <> 0) AND (NOT FirstMenu)
  265.     THEN len := len + 10;               {bump to second menu}
  266.  
  267.     IF (len < minptr) OR (len > maxptr) THEN BEGIN
  268.       Write(^G);                        {dummy}
  269.       Check_Key := FALSE;
  270.     END
  271.     ELSE menuptr := len;                {post global}
  272.   END;  {of Check_Key}
  273.  
  274.  
  275. PROCEDURE Check_Range;
  276.   {Insure menuptr is in correct range}
  277.   BEGIN
  278.     IF menuptr > maxptr                 {went beyond bottom}
  279.     THEN menuptr := minptr              {back to top}
  280.     ELSE IF menuptr < minptr            {went beyond top}
  281.     THEN menuptr := maxptr;             {so go to end}
  282.   END;  {of Check_Range}
  283.  
  284.  
  285. PROCEDURE Switch_Menu;
  286.   {Switch from current menu to the other one}
  287.   BEGIN
  288.     ClrScr;
  289.     FirstMenu := NOT FirstMenu;       {toggle}
  290.     New_Menu;
  291.   END;  {of Switch_Menu}
  292.  
  293.  
  294. {****************************************************************************}
  295. FUNCTION menu : INTEGER;
  296.   {Returns selected item number, plus global CmdParm string.}
  297.   LABEL
  298.     MenuStart,Menu_End;
  299.  
  300.   BEGIN {MENU}
  301.  
  302.     Setup_Screen;
  303.  
  304.     REPEAT
  305.  
  306. MenuStart:
  307.       Repaint(menuptr,TRUE);            {TH Actually display the current
  308.                                          menu item.  Updates PtrOver10.}
  309.  
  310.       READ(Kbd,InChar);                 {GET A CHARACTER FROM THE USER}
  311.  
  312.       IF InChar = #13 THEN Goto Menu_End; {he selected this one}
  313.  
  314.       IF (InChar = #32) THEN BEGIN      {SPACEBAR PRESSED }
  315.         IF LenOver10               {more than 1 menu}
  316.         THEN Switch_Menu           {so go ahead and switch}
  317.         ELSE Write(^G);            {dummy}
  318.         Goto MenuStart;            {loop back either way}
  319.       END;
  320.  
  321.       last := menuptr;
  322.  
  323.       IF (InChar = ^[) AND KeyPressed   {IF FUNCTION KEY PRESSED }
  324.       THEN BEGIN
  325.         READ(Kbd, InChar);              {get the 2d char}
  326.  
  327.         CASE InChar OF
  328.           'H' : BEGIN        {UP ARROW PRESSED}
  329.                   menuptr := PRED(menuptr);
  330.                   Check_Range;
  331.                 END;  {if H, UpAr}
  332.           'P' : BEGIN   {DOWN ARROW PRESSED}
  333.                   menuptr := SUCC(menuptr);
  334.                   Check_Range;
  335.                 END;  {if P, DnAr}
  336.            'G' :  menuptr := minptr;  {Home}
  337.            'O' :  menuptr := maxptr;  {End}
  338.            'I',         {Page down}
  339.            'Q' : BEGIN  {Page up}
  340.                    IF LenOver10               {more than 1 menu}
  341.                    THEN Switch_Menu           {so go ahead and switch}
  342.                    ELSE Write(^G);            {dummy}
  343.                    Goto MenuStart;            {loop back either way}
  344.                  END;
  345.           ELSE IF Check_Key(TRUE)             {check other func keys}
  346.           THEN Goto Menu_End;  {might beep}
  347.         END;  {case}
  348.       END  {if a Func Key}
  349.       ELSE IF Check_Key(FALSE)                {check char keys}
  350.       THEN Goto Menu_End;                     {might beep}
  351.  
  352.       Repaint(last,FALSE);                        {turn off the last one}
  353.     UNTIL FALSE = TRUE;
  354.  
  355. Menu_End:
  356.  
  357.     menu := menuptr;                    {return the value}
  358.  
  359.     Get_Cmd;                            {get any DOS command parameters}
  360.  
  361.     Window(1,1,80,25);                  {RESET FULL SCREEN AS WINDOW}
  362.  
  363.     RvsOff;
  364.     ClrScr;
  365.     Cursor(on);
  366.   END;  {of menu}
  367.